home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / OGRID110 / DEMO_GL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-01  |  31KB  |  1,027 lines

  1. {*****************************************************************************
  2.  
  3.   OOGrid Library(TM) for Borland/Turbo Pascal (Real Mode/TV)
  4.   Copyright (C) 1994, 1995 by Arturo J. Monge
  5.   Portions Copyright (C) 1989,1990 Borland International, Inc.
  6.  
  7.   OOGrid Library(TM) Demo Program:
  8.     Example program of how to use a TSpreadSheet object in an
  9.     application.  Demonstrates how to create, load and save
  10.     spreadsheets, how to modify the standard application palette
  11.     to support the use of a TSpreadSheet object and how to set up
  12.     the program resources so that they can be used by the
  13.     TSpreadSheet object.
  14.  
  15.   Copyright (C) 1994, 1995 by Arturo J. Monge
  16.  
  17.   Last Modification : May 31st, 1994
  18.  
  19. *****************************************************************************}
  20.  
  21. program OOGL_DemoProgram;
  22.  
  23. {$O+,F+,X+}
  24.  
  25. uses Dos, App, Objects, Views, Drivers, Gadgets, MsgBox, Menus, Memory,
  26.      HelpFile, StdDlg, Dialogs, GLViews, GLEquate, GLWindow, GLTSheet,
  27.      GLSupprt, DemoEqu,
  28.      TCUtil { OOGL_DemoProgram uses TCUtil's UpperCase function };
  29.  
  30. var
  31.   DemoStrings : PStringList;
  32.   { String list used by OOGL_DemoProgram }
  33.  
  34.   DemoResource : TResourceFile;
  35.   { Resource file used by OOGL_DemoProgram }
  36.  
  37. const
  38.   ResourceFileName = 'DEMO_GL.TVR';
  39.   { Filename of the file that contains the resource used by OOGL_DemoProgram }
  40.  
  41. const
  42.   HelpInUse : Boolean = False;
  43.   { Is set to true when the help window is active }
  44.  
  45. const
  46.   MaxNumberOfFiles = 255;
  47.  
  48. type
  49.   FileNumbers = Set of 1..MaxNumberOfFiles;
  50.  
  51. var
  52.   FilesOpen  : FileNumbers;
  53.   { Keeps track of which FileNumbers are currently in use }
  54.  
  55.   SaveMem : LongInt;
  56.   { Used to determine if all memory has been properly disposed by the program }
  57.  
  58. function CalcName(AName: String): PathStr; forward;
  59. function NewNumberAvailable (var NewFileNumber:Integer;
  60.   var FilesOpen:FileNumbers):Boolean; forward;
  61.  
  62. type
  63.   POOGridLibraryDemo = ^TOOGridLibraryDemo;
  64.   TOOGridLibraryDemo = object(TApplication)
  65.       HelpFile   : PathStr;
  66.       Clock      : PClockView;
  67.       HeapViewer : PHeapView;
  68.     constructor Init(HelpFileName: String);
  69.     procedure AddClock; virtual;
  70.     procedure AddHeapViewer; virtual;
  71.     procedure AddSpreadSheet; virtual;
  72.     function GetPalette:PPalette; virtual;
  73.     procedure GetEvent (var Event:TEvent); virtual;
  74.     procedure HandleEvent (var Event : TEvent); virtual;
  75.     procedure Idle; virtual;
  76.     procedure InitMenuBar; virtual;
  77.     procedure InitStatusLine; virtual;
  78.     procedure LoadSpreadSheet(FileName: PathStr); virtual;
  79.     procedure SaveSpreadSheet(NewName: Boolean); virtual;
  80.     procedure OutofMemory; virtual;
  81.     procedure ShowWindowList; virtual;
  82.     destructor Done; virtual;
  83.   end; {...TOOGridLibraryDemo }
  84.  
  85.  
  86.   PHCStatusLine = ^THCStatusLine;
  87.   THCStatusLine = object(TStatusLine)
  88.     function Hint(AHelpCtx: Word): String; virtual;
  89.   end; {...THCStatusLine }
  90.  
  91.  
  92.   PMySpreadSheet = ^TMySpreadSheet;
  93.   TMySpreadSheet = object(TSpreadSheetWindow)
  94.   { A descendant of TSpreadSheetWindow that owns a TSpreadSheet object.
  95.     An instance of TSpreadSheet is created and inserted into TMySpreadSheet
  96.     in the Init method.  It also overrides the GetPalette method to map the
  97.     color entries the standard palette entries after the help system's
  98.     palette }
  99.     constructor Init(Bounds : TRect; ATitle : String; ANumber: Byte);
  100.     function GetPalette: PPalette; virtual;
  101.     destructor Done; virtual;
  102.   end; {...TMySpreadSheet }
  103.  
  104.  
  105.   PWinTitleCollection = ^TWinTitleCollection;
  106.   TWinTitleCollection = object(TStringCollection)
  107.   { Aa string collection used by TWindowList that doesn't cause a run-time
  108.     error whenever an error ocurrs.  Instead, it set the Status attribute to
  109.     1 when an error ocurrs.  This is to avoid an unwanted run-time error when
  110.     there is not enough memory to list all active windows in a TWindowList
  111.     object }
  112.       Status : Byte; { Status of the collection:
  113.                        0 : OK
  114.                        1 : Error ocurred }
  115.     constructor Init(ALimit, ADelta: Integer);
  116.     procedure Error(Code, Info: Integer); virtual;
  117.   end; {...TWinTitle Collection }
  118.  
  119.  
  120.  
  121.   PWindowListBox = ^TWindowListBox;
  122.   TWindowListBox = object(TSortedListBox)
  123.   { Handles double-clicking by generating a cmOk command. It is used by
  124.     TWindowList to list all open windows. }
  125.     procedure HandleEvent(var Event:TEvent); virtual;
  126.   end; {...TWindowListBox }
  127.  
  128.  
  129.  
  130.   PWindowList = ^TWindowList;
  131.   TWindowList = object(TDialog)
  132.   { A dialog that allows the user to select or delete a window in the desktop
  133.     from a list }
  134.       WinBox : PWindowListBox;
  135.     constructor Init(Bounds:TRect);
  136.     procedure BuildWindowList(var TitleList: PWinTitleCollection);
  137.     procedure DeleteWindow;
  138.     procedure HandleEvent(var Event:TEvent); virtual;
  139.     constructor Load(var S: TStream);
  140.     procedure SelectWindow;
  141.     procedure Store(var S: TStream);
  142.     destructor Done; virtual;
  143.   end; {...TWindowList }
  144.  
  145.  
  146. {** THCStatusLine **}
  147.  
  148. function THCStatusLine.Hint(AHelpCtx: Word): String;
  149. begin
  150.    Hint := DemoStrings^.Get(AHelpCtx);
  151. end; {...THCStatusLine.Hint }
  152.  
  153.  
  154. {** TMySpreadSheet **}
  155.  
  156. constructor TMySpreadSheet.Init(Bounds: TRect; ATitle: String; ANumber: Byte);
  157. var
  158.    R : TRect;
  159.    SpreadSheet : PSpreadSheet;
  160. begin
  161.    TSpreadSheetWindow.Init(Bounds, ATitle, ANumber);
  162.    GetExtent(R);
  163.    R.Grow(-1,-1);
  164.    SpreadSheet := New(PSpreadSheet, Init(R, 0, DefaultEmptyRowsAtTop,
  165.      DefaultEmptyRowsAtBottom, StandardScrollBar(sbHorizontal),
  166.      StandardScrollBar(sbVertical),DefaultMaxCols, DefaultMaxRows,
  167.      DefaultDefaultColWidth, DefaultDefaultDecimalPlaces,
  168.      DefaultMaxDecimalPlaces, DefaultCurrencyString));
  169.  
  170.    Insert(SpreadSheet);
  171. end; {...TMySpreadSheet.Init }
  172.  
  173. function TMySpreadSheet.GetPalette: PPalette;
  174. const
  175.   CNewPalette = CBlueWindow + CSpreadSheetWindow2;
  176.   PNewPalette : string[Length(CNewPalette)] = CNewPalette;
  177. begin
  178.   GetPalette := @PNewPalette;
  179. end; {...TMySpradSheet.GetPalette }
  180.  
  181. destructor TMySpreadSheet.Done;
  182. begin
  183.   { Make available the number used by the instance of TMySpreadSheet
  184.     being closed }
  185.   FilesOpen := FilesOpen - [Number];
  186.   TSpreadSheetWindow.Done;
  187. end; {...TMySpreadSheet.Done }
  188.  
  189.  
  190.  
  191. {** TOOGridLibraryDemo **}
  192.  
  193. constructor TOOGridLibraryDemo.Init(HelpFileName: String);
  194. begin
  195.   TApplication.Init;
  196.   if HelpFileName = '' then
  197.     HelpFile := ''
  198.   else
  199.     HelpFile := CalcName(HelpFileName);
  200.   FilesOpen := [];
  201.   AddClock;
  202.   AddHeapViewer;
  203. end; {...TOOGridLibraryDemo.Init }
  204.  
  205.  
  206. procedure TOOGridLibraryDemo.AddClock;
  207. { Adds a clock to the application in the upper right corner }
  208. var
  209.   R : TRect;
  210. begin
  211.   GetExtent(R);
  212.   R.B.Y := R.A.Y + 1;
  213.   R.A.X := R.B.X - 9;
  214.   Clock := New(PClockView, Init(R));
  215.   Insert(Clock);
  216. end; {...TOOGridLibraryDemo.AddClock }
  217.  
  218.  
  219. procedure TOOGridLibraryDemo.AddHeapViewer;
  220. { Insert an indicator of the available memory in the lower left corner }
  221. var
  222.   R : TRect;
  223. begin
  224.   GetExtent(R);
  225.   R.A.Y := R.B.Y - 1;
  226.   R.A.X := R.B.X - 9;
  227.   HeapViewer := New(PHeapView, Init(R));
  228.   Insert(HeapViewer);
  229. end; {...TOOGridLibraryDemo.AddHeapViewer }
  230.  
  231.  
  232. procedure TOOGridLibraryDemo.AddSpreadSheet;
  233. { Creates a new spreadsheet and inserts it in the desktop }
  234. var
  235.    NewNumber : Integer;
  236.    NumberStr : String;
  237.    SpreadSheet : PMySpreadSheet;
  238.    R, Limits : TRect;
  239. begin
  240.   if not NewNumberAvailable(NewNumber, FilesOpen) then
  241.   begin
  242.     MessageBox(DemoStrings^.Get(sMaxFilesOpenError), NIL,
  243.       mfError + mfOkButton);
  244.     Exit;
  245.   end; {...if not NewNumberAvailable(NewNumber, FilesOpen) }
  246.  
  247.   { Determine the window's new bounds }
  248.  
  249.   if Desktop^.Current <> NIL then
  250.     begin
  251.       R.A := Desktop^.Current^.Origin;
  252.       R.B.X := R.A.X + Desktop^.Current^.Size.X;
  253.       R.B.Y := R.A.Y + Desktop^.Current^.Size.Y;
  254.       Inc(R.A.X);
  255.       Inc(R.A.Y);
  256.     end {...if Desktop^.Current <> NIL }
  257.   else
  258.     Desktop^.GetExtent(R);
  259.   Str(NewNumber, NumberStr);
  260.   SpreadSheet := New(PMySpreadSheet, Init(R,
  261.     DemoStrings^.Get(sNoNameFileName)+NumberStr, NewNumber));
  262.  
  263.   { Verify that the new bounds are not below the allowed limits }
  264.   SpreadSheet^.SizeLimits(Limits.A, Limits.B);
  265.   if ((R.B.Y - R.A.Y) < Limits.A.Y) or ((R.B.X - R.A.X) < Limits.A.X) then
  266.   begin
  267.     Desktop^.GetExtent(R);
  268.     SpreadSheet^.ChangeBounds(R);
  269.   end; {...if ((R.B.Y - R.A.Y) < Limits.A.Y) or ... }
  270.  
  271.   if Application^.ValidView(Spreadsheet) <> nil then
  272.     begin
  273.       Desktop^.Insert(SpreadSheet);
  274.       EnableCommands([cmSave, cmSaveAs, cmPrintSheet, cmYes, cmNo,
  275.       cmCloseAll]);
  276.     end { if }
  277.   else
  278.     Dispose(Spreadsheet, Done);
  279. end; { TOOGridLibraryDemo.AddSpreadsheet }
  280.  
  281. function TOOGridLibraryDemo.GetPalette: PPalette;
  282. { Adds palette items to the standard application palette for the help system
  283.   and for the TSpreadSheet object}
  284. const
  285.   CNewColor = CColor + CHelpColor + CSpreadSheetColor;
  286.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite + CSpreadSheetBlackWhite;
  287.   CNewMonochrome = CMonochrome + CHelpMonochrome + CSpreadSheetMonochrome;
  288.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  289.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  290. begin
  291.   GetPalette := @P[AppPalette];
  292. end; {...TOOGridLibraryDemo.GetPalette }
  293.  
  294.  
  295. procedure TOOGridLibraryDemo.GetEvent(var Event: TEvent);
  296. { Handles the cmHelp command by displaying context sensitive help }
  297. var
  298.   HelpBox    : PWindow;
  299.   HFile      : PHelpFile;
  300.   HelpStrm   : PDosStream;
  301. begin
  302.   TApplication.GetEvent(Event);
  303.   case Event.What of
  304.     evCommand:
  305.       if (Event.Command = cmHelp) and (HelpFile <> '') and
  306.         not HelpInUse then
  307.       begin
  308.         HelpInUse := True;
  309.         HelpStrm := New(PBufStream, Init(HelpFile, stOpenRead, 2048));
  310.         HFile := New(PHelpFile, Init(HelpStrm));
  311.         if HelpStrm^.Status <> stOk then
  312.           begin
  313.             MessageBox(DemoStrings^.Get(sHelpAccessError), NIL,
  314.               mfError + mfCancelButton);
  315.             Dispose(HFile, Done);
  316.             ClearEvent(Event);
  317.           end {...if HelpStrm^.Status <> stOk }
  318.         else
  319.           begin
  320.             HelpBox := New(PHelpWindow,Init(HFile, GetHelpCtx));
  321.             if ValidView(HelpBox) <> nil then
  322.             begin
  323.               ExecView(HelpBox);
  324.               Dispose(HelpBox, Done);
  325.             end; {...if ValidView(HelpBox) <> NIL }
  326.             ClearEvent(Event);
  327.           end; {...else/if }
  328.         HelpInUse := False;
  329.       end; {...if (Event.Command = cmHelp) and not HelpInUse }
  330.  
  331.     evMouseDown:
  332.       if Event.Buttons <> 1 then
  333.         Event.What := evNothing;
  334.   end; {...case Event.What }
  335. end; {...TOOGridLibraryDemo.GetEvent }
  336.  
  337.  
  338. procedure TOOGridLibraryDemo.HandleEvent(VAR Event : TEvent);
  339. { Handles common commands like cmTile, cmCascade, cmDosShell, cmVideoMode
  340.   and cmList, plus application especific commands }
  341.  
  342.     procedure ChangeVideo;
  343.     var
  344.       NewMode : Word;
  345.     begin
  346.       Dispose(HeapViewer, Done);
  347.       NewMode := ScreenMode xor smFont8x8;
  348.       if NewMode and smFont8x8 <> 0 then
  349.         ShadowSize.X := 1
  350.       else
  351.         ShadowSize.X := 2;
  352.       SetScreenMode(NewMode);
  353.       AddHeapViewer;
  354.     end; {...ChangeVideo }
  355.  
  356. {$ifdef ver60}
  357.  
  358.     procedure DosShell;
  359.     begin
  360.       DoneSysError;
  361.       DoneEvents;
  362.       DoneVideo;
  363.       DoneMemory;
  364.       SetMemTop(HeapPtr);
  365.       PrintStr(DemoStrings^.Get(sShellMsg));
  366.       SwapVectors;
  367.       Exec(GetEnv('COMSPEC'), '');
  368.       SwapVectors;
  369.       SetMemTop(HeapEnd);
  370.       InitMemory;
  371.       InitVideo;
  372.       InitEvents;
  373.       InitSysError;
  374.       Redraw;
  375.     end; {...GoToDos }
  376.  
  377.     procedure Tile;
  378.     var
  379.       R: TRect;
  380.     begin
  381.       Desktop^.GetExtent(R);
  382.       Desktop^.Tile(R);
  383.     end; {...Tile }
  384.  
  385.     procedure Cascade;
  386.     var
  387.       R: TRect;
  388.     begin
  389.       Desktop^.GetExtent(R);
  390.       Desktop^.Cascade(R);
  391.     end; {...Cascade }
  392.  
  393. {$endif}
  394.  
  395.     procedure CloseAll;
  396.     { Close all open windows in the desktop, by disposing it and
  397.       creating a new instance of TDesktop }
  398.     begin
  399.        Dispose(Desktop, Done);
  400.        InitDesktop;
  401.        Insert(Desktop);
  402.     end; {...CloseAll }
  403.  
  404.     procedure DisplayDialog(ResourceKey: String);
  405.     var
  406.       Dialog : PDialog;
  407.     begin
  408.       Dialog := PDialog(DemoResource.Get(ResourceKey));
  409.       if Application^.ValidView(Dialog) <> NIL then
  410.         Desktop^.ExecView(Dialog);
  411.       if Dialog <> NIL then
  412.         Dispose(Dialog, Done);
  413.     end; {...DisplayDialog }
  414.  
  415.  
  416.  
  417. begin
  418.   TApplication.HandleEvent(Event);
  419.   if (Event.what = evCommand) then
  420.     case Event.Command of
  421.       cmAbout         : DisplayDialog('AboutDialog');
  422.       cmAuthorInfo    : DisplayDialog('AuthorDialog');
  423.       cmCascade       : Cascade;
  424.       cmChDir         : DisplayDialog('ChDirDialog');
  425.       cmCloseAll      : CloseAll;
  426.       cmDosShell      : DosShell;
  427.       cmList          : ShowWindowList;
  428.       cmLoadTypes     : LoadSpreadSheet(CalcName('EX_TYPES.OGL'));
  429.       cmLoadFunctions : LoadSpreadSheet(CalcName('EX_FUNCT.OGL'));
  430.       cmLoadList1     : LoadSpreadSheet(CalcName('EX_LIST1.OGL'));
  431.       cmLoadList2     : LoadSpreadSheet(CalcName('EX_LIST2.OGL'));
  432.       cmLoadErrors    : LoadSpreadSheet(CalcName('EX_ERROR.OGL'));
  433.       cmLoadDataEntry : LoadSpreadSheet(CalcName('EX_ENTRY.OGL'));
  434.       cmNewSheet      : AddSpreadSheet;
  435.       cmOpen          : LoadSpreadSheet('');
  436.       cmRefresh       : Application^.Redraw;
  437.       cmRegister      : DisplayDialog('RegistrationDialog');
  438.       cmSave          : SaveSpreadSheet(False);
  439.       cmSaveAs        : SaveSpreadSheet(True);
  440.       cmTile          : Tile;
  441.       cmVideoMode     : ChangeVideo;
  442.     end; {...case Event.Command }
  443. end; {...TOOGridLibraryDemo.HandleEvent }
  444.  
  445.  
  446. procedure TOOGridLibraryDemo.Idle;
  447. { Determines if the current view is tileable and enables or disables menu
  448.   commands accordingly.  It also updates the clock and the heap viewer }
  449.  
  450.     function IsTileable(P: PView): Boolean; far;
  451.     begin
  452.       IsTileable := P^.Options and ofTileable <> 0;
  453.     end; {...IsTileable }
  454.  
  455. begin
  456.   TApplication.Idle;
  457.   if not (Clock = NIL) then
  458.      Clock^.Update;
  459.   if not (HeapViewer = NIL) then
  460.      HeapViewer^.Update;
  461.   If Desktop^.FirstThat(@IsTileable) <> nil then
  462.     EnableCommands([cmTile, cmCascade])
  463.   else
  464.     DisableCommands([cmTile, cmCascade]);
  465.   if (DeskTop^.Current = NIL) and (HelpInUse = False) then
  466.     SetCommands ([cmNewSheet, cmOpen, cmDosShell, cmQuit, cmList, cmHelp,
  467.       cmChDir, cmAbout, cmAuthorInfo, cmRegister, cmRefresh, cmVideoMode,
  468.       cmOk, cmDeleteWin, cmCancel, cmMenu, cmLoadTypes, cmLoadFunctions,
  469.       cmLoadList1, cmLoadList2, cmLoadErrors, cmLoadDataEntry]);
  470. end; {...TOOGridLibraryDemo.Idle }
  471.  
  472.  
  473. procedure TOOGridLibraryDemo.InitMenuBar;
  474. begin
  475.   MenuBar := PMenuBar(DemoResource.Get('MenuBar'));
  476. end; {...TOOGridLibraryDemo.InitMenuBar }
  477.  
  478. procedure TOOGridLibraryDemo.InitStatusLine;
  479. var
  480.   R : TRect;
  481. begin
  482.   R.Assign(0, 24, 80, 25);
  483.   StatusLine := New(PHCStatusLine, Init(R,
  484.     NewStatusDef(0, 1000,
  485.        NewStatusKey('~Alt-F1~ Info', kbAltF1, cmAbout,
  486.        NewStatusKey('', kbF10, cmMenu,
  487.        NewStatusKey('', kbAltX, cmQuit,
  488.        NewStatusKey('', kbAltF3, cmClose,
  489.        NewStatusKey('', kbF5, cmZoom,
  490.        NewStatusKey('', kbCtrlF5, cmResize,
  491.        NewStatusKey('', kbF6, cmNext,
  492.        NIL))))))),
  493.     NIL)));
  494. end; {...TOOGridLibraryDemo.InitStatusBar }
  495.  
  496. procedure TOOGridLibraryDemo.LoadSpreadSheet(FileName: PathStr);
  497. { Loads a spreadsheet from disk }
  498. var
  499.   Stream : PBufStream;
  500.   Dialog : PDialog;
  501.   NewSS : PMySpreadSheet;
  502.   NewNumber : Integer;
  503.   R, Limits : TRect;
  504. begin
  505.   if FileName = '' then
  506.   begin
  507.     Dialog := PDialog(DemoResource.Get('LoadDialog'));
  508.     if Application^.ValidView(Dialog) = NIL then
  509.        Exit
  510.     else
  511.       begin
  512.         if Desktop^.ExecView(Dialog) <> cmCancel then
  513.            Dialog^.GetData(FileName)
  514.         else
  515.            begin
  516.               Dispose(Dialog, Done);
  517.               Exit;
  518.            end; {...if/else }
  519.       end; {...if/else }
  520.     Dispose(Dialog, Done);
  521.   end; {...if FileName = '' }
  522.   Stream := New(PBufStream, Init(FileName, stOpenRead, 1024));
  523.   if Stream^.Status <> 0 then
  524.   begin
  525.     MessageBox(DemoStrings^.Get(sFileNotFound), NIL, mfError + mfOkButton);
  526.     Dispose(Stream, Done);
  527.     Exit;
  528.   end; {...if Stream^.Status <> 0 }
  529.   DisplayMessage(DemoStrings^.Get(sLoadMessage));
  530.   NewSS := PMySpreadSheet(Stream^.Get);
  531.   EraseMessage;
  532.   if Stream^.Status <> 0 then
  533.   begin
  534.     if Stream^.Status = stInvalidFormatError then
  535.     { Two new stream status constants are used by OOGrid Library(TM) v1.0:
  536.       stInvalidFormatError and stNoMemoryError.  They are defined in
  537.       the GLSupprt unit }
  538.       MessageBox(DemoStrings^.Get(sInvalidFormat), NIL, mfError + mfOkButton)
  539.     else if Stream^.Status <> stNoMemoryError then
  540.     { Memory errors are reported by the LowMemory function; there is no
  541.       need to report them again }
  542.       MessageBox(DemoStrings^.Get(sAccessError), NIL, mfError + mfOkButton);
  543.     Dispose(NewSS, Done);
  544.     Dispose(Stream, Done);
  545.     Exit;
  546.   end; {...if Stream^.Status <> 0 }
  547.   Dispose(Stream, Done);
  548.   if not NewNumberAvailable(NewNumber, FilesOpen) then
  549.   begin
  550.     MessageBox(DemoStrings^.Get(sMaxFilesOpenError), NIL,
  551.       mfError + mfOkButton);
  552.     Exit;
  553.   end; {...if not NewNumberAvailable(NewNumber, FilesOpen) }
  554.  
  555.   { Set the title to the current filename }
  556.   if NewSS^.Title <> NIL then
  557.     DisposeStr(NewSS^.Title);
  558.   NewSS^.Title := NewStr(FileName);
  559.  
  560.   NewSS^.Number := NewNumber;
  561.  
  562.   { Determine the window's new bounds }
  563.   if Desktop^.Current <> NIL then
  564.     begin
  565.       R.A := Desktop^.Current^.Origin;
  566.       R.B.X := R.A.X + Desktop^.Current^.Size.X;
  567.       R.B.Y := R.A.Y + Desktop^.Current^.Size.Y;
  568.       Inc(R.A.X);
  569.       Inc(R.A.Y);
  570.  
  571.       { Verify that the new bounds are not below the allowed limits }
  572.       NewSS^.SizeLimits(Limits.A, Limits.B);
  573.       if ((R.B.Y - R.A.Y) < Limits.A.Y) or ((R.B.X - R.A.X) < Limits.A.X) then
  574.         Desktop^.GetExtent(R);
  575.     end {...if Desktop^.Current <> NIL }
  576.   else
  577.     Desktop^.GetExtent(R);
  578.  
  579.   NewSS^.ChangeBounds(R);
  580.   Desktop^.Insert(NewSS);
  581.   EnableCommands([cmSave, cmSaveAs, cmPrintSheet, cmYes, cmNo, cmCloseAll]);
  582. end; {..TOOGridLibraryDemo.LoadSpreadSheet }
  583.  
  584.  
  585. procedure TOOGridLibraryDemo.OutofMemory;
  586. var
  587.   R : TRect;
  588. begin
  589.   R.Assign(20,8,58,17);
  590.   MessageBox(DemoStrings^.Get(sNoMemError), NIL, mfError + mfCancelButton);
  591. end; {...TOOGridLibraryDemo.OutOfMemory }
  592.  
  593.  
  594. procedure TOOGridLibraryDemo.SaveSpreadSheet(NewName: Boolean);
  595. { Saves a spreadsheet to disk }
  596. var
  597.   Stream : PBufStream;
  598.   Dialog : PDialog;
  599.   CurrSS : PMySpreadSheet;
  600.   FileName : PathStr;
  601. begin
  602.   CurrSS := PMySpreadSheet(Desktop^.Current);
  603.  
  604.   if NewName or (Copy(CurrSS^.Title^, 1,
  605.     Length(DemoStrings^.Get(sNoNameFileName))) =
  606.     DemoStrings^.Get(sNoNameFileName)) then
  607.   { if the file will be saved under a new name or if the file does not
  608.     have a name, prompt the user for a new name }
  609.     begin
  610.       Dialog := PDialog(DemoResource.Get('SaveDialog'));
  611.       if Application^.ValidView(Dialog) = NIL then
  612.          Exit
  613.       else
  614.         begin
  615.           if Desktop^.ExecView(Dialog) <> cmCancel then
  616.             begin
  617.               Dialog^.GetData(FileName);
  618.  
  619.               { Change the window's title }
  620.               if CurrSS^.Title <> NIL then
  621.                 DisposeStr(CurrSS^.Title);
  622.               CurrSS^.Title := NewStr(FileName);
  623.               CurrSS^.Redraw;
  624.             end {...if Desktop^.ExecView(Dialog) <> cmCancel }
  625.           else
  626.              begin
  627.                 Dispose(Dialog, Done);
  628.                 Exit;
  629.              end; {...if/else }
  630.           end; {...if else }
  631.       Dispose(Dialog, Done);
  632.     end {...if NewName or ... }
  633.   else
  634.     FileName := CurrSS^.Title^;
  635.   Stream := New(PBufStream, Init(FileName, stCreate, 1024));
  636.   if Stream^.Status <> 0 then
  637.   begin
  638.     MessageBox(DemoStrings^.Get(sCreateStreamError), NIL, mfError +
  639.       mfOkButton);
  640.     Dispose(Stream, Done);
  641.     Exit;
  642.   end; {...if Stream^.Status <> 0 }
  643.   DisplayMessage(DemoStrings^.Get(sSaveMessage));
  644.   Stream^.Put(Desktop^.Current);
  645.   EraseMessage;
  646.   if Stream^.Status <> 0 then
  647.     MessageBox(DemoStrings^.Get(sSaveError), NIL, mfError + mfOkButton);
  648.   Dispose(Stream, Done);
  649.  
  650. end; {..TOOGridLibraryDemo.SaveSpreadSheet }
  651.  
  652.  
  653. procedure TOOGridLibraryDemo.ShowWindowList;
  654. { Shows a dialog for selecting a window from a list of active windows }
  655.  
  656. var
  657.   WindowLst    : PWindowList;
  658.   CurrSelected : PWindow;
  659.   R            : TRect;
  660. begin
  661.   R.Assign(0,0,60,15);
  662.   WindowLst := New(PWindowList, Init(R));
  663.   if Application^.ValidView(WindowLst) <> NIL then
  664.   begin
  665.     If (ExecView(WindowLst) <> cmCancel) then
  666.     begin
  667.       CurrSelected := PWindow(DeskTop^.Current);
  668.       If (CurrSelected^.Flags and wfClose <> 0) then
  669.         EnableCommands([cmClose])
  670.       else
  671.         DisableCommands([cmClose]);
  672.       CommandSetChanged := True;
  673.     end; {...if (ExecView(WindowLst) <> cmCancel) }
  674.     Dispose(WindowLst, Done);
  675.   end; {...if (Application^.ValidView(WindowLst) = PView(WindowLst)) }
  676. end; {...ShowWindowList }
  677.  
  678.  
  679. destructor TOOGridLibraryDemo.Done;
  680. begin
  681.   if not (Clock = NIL) then
  682.      Dispose(Clock, Done);
  683.   if not (HeapViewer = NIL) then
  684.      Dispose(HeapViewer, Done);
  685.   TApplication.Done;
  686. end; {...TOOGridLibraryDemo.Done }
  687.  
  688.  
  689.  
  690. {** TWindowList **}
  691.  
  692. constructor TWindowList.Init(Bounds: TRect);
  693. { The BuildList parameter tells the object if it should or should not
  694.   build the list of open windows. }
  695. var
  696.   SizeX, SizeY : Integer;
  697.   Control : PView;
  698.   TitleList : PWinTitleCollection;
  699.   WinBoxLabel : String;
  700.   R : TRect;
  701. begin
  702.   SizeX := (Bounds.B.X - Bounds.A.X);
  703.   SizeY := (Bounds.B.Y - Bounds.A.Y);
  704.   If ((SizeY MOD 2) = 0) then
  705.   begin
  706.     Inc(Bounds.B.Y);
  707.     Inc(SizeY);
  708.   end; {...if ((SizeY MOD 2) = 0) }
  709.   TDialog.Init(Bounds, 'Window list...');
  710.   HelpCtx := hcWinListDlgHelp;
  711.   Options := Options + ofCentered;
  712.  
  713.   R.A.X := (SizeX - 14);
  714.   R.A.Y := 3;
  715.   R.B.X := (R.A.X + 12);
  716.   R.B.Y := 5;
  717.   Control := New(PButton, Init(R, '~O~k', cmOk, bfDefault));
  718.   Control^.HelpCtx := hcOk;
  719.   Insert(Control);
  720.  
  721.   R.A.X := (SizeX - 14);
  722.   R.A.Y := (((SizeY - 5) DIV 3) + 3);
  723.   R.B.X := (R.A.X + 12);
  724.   R.B.Y := R.A.Y + 2;
  725.   Control := New(PButton, Init(R, '~D~elete', cmDeleteWin, bfNormal));
  726.   Control^.HelpCtx := hcDeleteWin;
  727.   Insert(Control);
  728.  
  729.   R.A.X := (SizeX - 14);
  730.   R.A.Y := (SizeY - 3)-((SizeY - 5) DIV 3);
  731.   R.B.X := (R.A.X + 12);
  732.   R.B.Y := R.A.Y + 2;
  733.   Control := New(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
  734.   Control^.HelpCtx := hcCancel;
  735.   Insert(Control);
  736.  
  737.   R.A.X := (SizeX - 14);
  738.   R.A.Y := (SizeY - 3);
  739.   R.B.X := (R.A.X + 12);
  740.   R.B.Y := R.A.Y + 2;
  741.   Control := New(PButton, Init(R, 'Help', cmHelp, bfNormal));
  742.   Insert(Control);
  743.  
  744.   R.A.X := (SizeX - 16);
  745.   R.A.Y := 3;
  746.   R.B.X := R.A.X + 1;
  747.   R.B.Y := (SizeY - 2);
  748.   Control := New(PScrollBar, Init(R));
  749.   Insert(Control);
  750.  
  751.   R.A.X := 3;
  752.   R.A.Y := 3;
  753.   R.B.X := (SizeX - 16);
  754.   R.B.Y := (SizeY - 2);
  755.   WinBox := New(PWindowListBox, Init(R, 1, PScrollBar(Control)));
  756.   TitleList := New(PWinTitleCollection, Init(12,1));
  757.   BuildWindowList(TitleList);
  758.   WinBox^.NewList(TitleList);
  759.   WinBox^.HelpCtx := hcWinList;
  760.   Insert(WinBox);
  761.  
  762.   WinBoxLabel := '~W~indows';
  763.   R.A.X := 2;
  764.   R.A.Y := 2;
  765.   R.B.X := R.A.X + Length(WinBoxLabel);
  766.   R.B.Y := 3;
  767.   Insert(New(PLabel, Init(R, WinBoxLabel, WinBox)));
  768. end; {...TWindowList.Init }
  769.  
  770.  
  771. procedure TWindowList.BuildWindowList(var TitleList: PWinTitleCollection);
  772. { Builds a list of all selectable active windows in the desktop }
  773. var
  774.   Curr     : PWindow;
  775.   ListText : PString;
  776. begin
  777.   if not(DeskTop^.Current = NIL) then
  778.   begin
  779.     Curr := PWindow(DeskTop^.First);
  780.     repeat
  781.       if (Curr^.Options and ofSelectable <> 0) then
  782.       begin
  783.         ListText := NewStr(UpperCase(Curr^.Title^));
  784.         TitleList^.Insert(ListText);
  785.       end; {...if (Curr^.Options and ofSelectable <> 0) }
  786.       Curr := PWindow(Curr^.Next);
  787.     until (Curr = PWindow(DeskTop^.Last)) or (TitleList^.Status = 1);
  788.     if TitleList^.Status = 1 then
  789.        MessageBox('Not enough memory to list all open windows.', NIL,
  790.                   mfInformation + mfOkButton);
  791.   end; {...if not(DeskTop^.Current = NIL) }
  792. end; {...TWindowList.BuildWindowList }
  793.  
  794.  
  795. procedure TWindowList.DeleteWindow;
  796. { Closes a window in the desktop }
  797.  
  798.     function SameTitle(CurrWin: PWindow): boolean; Far;
  799.     begin
  800.       if CurrWin^.Title^ = WinBox^.GetText(WinBox^.Focused, 80) then
  801.          SameTitle := True
  802.       else
  803.          SameTitle := False;
  804.     end; {...SameTitle }
  805.  
  806. var
  807.   DelMessage   : Pointer;
  808.   WinFocused   : Integer;
  809.   ViewToDelete : PWindow;
  810. begin
  811.   ViewToDelete := PWindow(DeskTop^.FirstThat(@SameTitle));
  812.   if not (ViewToDelete = NIL) and
  813.      (ViewToDelete^.Flags and wfClose <> 0) then
  814.   begin
  815.     DelMessage := Message(ViewToDelete, evCommand, cmClose, nil);
  816.     WinFocused := WinBox^.Focused;
  817.     WinBox^.List^.AtFree(WinFocused);
  818.     Dec(WinBox^.Range);
  819.     If (WinFocused > (WinBox^.Range - 1)) and (Winbox^.Range > 1) then
  820.       WinBox^.FocusItem(WinBox^.Range - 1);
  821.     WinBox^.DrawView;
  822.   end; {...if not(ViewToDelete = NIL) and ... }
  823. end; {...TWindowList.DeleteWindow }
  824.  
  825.  
  826. procedure TWindowList.HandleEvent(var Event: TEvent);
  827. { Handles the events for selecting and deleting windows in the desktop }
  828. begin
  829.   if (Event.what = evCommand) then
  830.     case Event.Command of
  831.       cmOk         : SelectWindow;
  832.       cmDeleteWin  : DeleteWindow;
  833.     end; {...case Event.Command }
  834.   TDialog.HandleEvent(Event);
  835. end; {...TWindowList.HandleEvent }
  836.  
  837. constructor TWindowList.Load(var S: TStream);
  838. { Loads the dialog from a stream }
  839. var
  840.    TitleList : PWinTitleCollection;
  841. begin
  842.   TDialog.Load(S);
  843.   GetSubViewPtr(S, WinBox);
  844.   TitleList := New(PWinTitleCollection, Init(12,1));
  845.   BuildWindowList(TitleList);
  846.   WinBox^.NewList(TitleList);
  847. end; {...TWindowList.Load }
  848.  
  849.  
  850. procedure TWindowList.SelectWindow;
  851. { Selects a window in the desktop }
  852.  
  853.     function SameTitle(CurrWin: PWindow): boolean; Far;
  854.     begin
  855.       if CurrWin^.Title^ = WinBox^.GetText(WinBox^.Focused, 256) then
  856.          SameTitle := True
  857.       else
  858.          SameTitle := False;
  859.     end; {...SameTitle }
  860.  
  861. begin
  862.   PWindow(DeskTop^.FirstThat(@SameTitle))^.Select;
  863. end; {...TWindowList.SelectWindow }
  864.  
  865. procedure TWindowList.Store(var S: TStream);
  866. begin
  867.   TDialog.Store(S);
  868.   PutSubViewPtr(S, WinBox);
  869. end; {...TWindowList.Store }
  870.  
  871.  
  872. destructor TWindowList.Done;
  873. begin
  874.    if NOT(WinBox^.List = NIL) then
  875.      Dispose (WinBox^.List, Done);
  876.    TDialog.Done;
  877. end; {...TWindowList.Done }
  878.  
  879.  
  880.  
  881. {** TWindowListbox **}
  882.  
  883. procedure TWindowListBox.HandleEvent(var Event:TEvent);
  884. { Handles double-clicking by generating a cmOk event }
  885. begin
  886.   if (Event.What = evMouseDown) and (Event.Double) then
  887.     begin
  888.       Event.What := evCommand;
  889.       Event.Command := cmOK;
  890.       PutEvent(Event);
  891.       ClearEvent(Event);
  892.     end {...if (Event.What = evMouseDown) and (Event.Double) }
  893.   else
  894.     TSortedListBox.HandleEvent(Event);
  895. end; {...TWindowListBox.HandleEvent }
  896.  
  897.  
  898.  
  899. {** TWinTitleCollection **}
  900.  
  901. constructor TWinTitleCollection.Init(ALimit, ADelta: Integer);
  902. begin
  903.    TStringCollection.Init(ALimit, ADelta);
  904.    Status := 0;
  905. end; {...TWinTitleCollection.Init }
  906.  
  907.  
  908. procedure TWinTitleCollection.Error(Code, Info: Integer);
  909. { Sets the status attribute to 1 so that any external method or procedure
  910.   knows when an error has ocurred }
  911. begin
  912.    Status := 1;
  913. end; {...TWinTitleCollection.Error }
  914.  
  915.  
  916. {** CalcName function **}
  917.  
  918. function CalcName(AName: String): PathStr;
  919. { Calculates the path name of the given file, by searching the directory
  920.   of the .EXE file and the DOS Path}
  921. var
  922.   PathName : PathStr;
  923.   Dir: DirStr;
  924.   Name: NameStr;
  925.   Ext: ExtStr;
  926. begin
  927.   FSplit(ParamStr(0), Dir, Name, Ext);
  928.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  929.   PathName := FSearch(AName, Dir);
  930.   if PathName = '' then
  931.     PathName := FSearch(AName, GetEnv('PATH'));
  932.   CalcName := PathName;
  933. end; {...CalcName }
  934.  
  935.  
  936. {** NewNumberAvailable function **}
  937.  
  938. function NewNumberAvailable (var NewFileNumber:Integer;
  939.   var FilesOpen:FileNumbers):Boolean;
  940. { Keeps track of which FileNumbers have been used and returns the lowest
  941.   available number }
  942. var
  943.   Number : Integer;
  944. begin
  945.   NewNumberAvailable := False;
  946.   for Number := 1 to MaxNumberofFiles do
  947.     if not (Number in FilesOpen) then
  948.     begin
  949.       NewFileNumber := Number;
  950.       FilesOpen := FilesOpen + [NewFileNumber];
  951.       NewNumberAvailable := True;
  952.       Exit;
  953.     end; {...if not (Number in FilesOpen ) }
  954. end; {...NewNumberAvailable }
  955.  
  956.  
  957. {** Registration records **}
  958.  
  959. const
  960.    RMySpreadSheet : TStreamRec = (
  961.       ObjType : 1100;
  962.       VmtLink : Ofs(TypeOf(TMySpreadSheet)^);
  963.       Load    : @TMySpreadSheet.Load;
  964.       Store   : @TMySpreadSheet.Store
  965.    );
  966.  
  967. {** RegisterAll procedure **}
  968.  
  969. procedure RegisterAll;
  970. begin
  971.   RegisterType(RStringList);
  972.   RegisterDialogs;
  973.   RegisterViews;
  974.   RegisterStdDlg;
  975.   RegisterMenus;
  976.   RegisterHelpFile;
  977.   RegisterSpreadSheet;
  978.   RegisterType(RMySpreadSheet);
  979. end; {...RegisterAll }
  980.  
  981. {****************************************************************************}
  982. {                               MAIN PROGRAM                                 }
  983. {****************************************************************************}
  984.  
  985. var
  986.   Demo : TOOGridLibraryDemo;
  987.  
  988. begin
  989.   RegisterAll;
  990.   SaveMem := MemAvail;
  991.  
  992.   DemoResource.Init(New(PBufStream, Init(ResourceFileName, stOpenRead, 1024)));
  993.   if DemoResource.Stream^.Status <> stOk then
  994.   begin
  995.     writeln('Resource not found...program aborted');
  996.     halt(1);
  997.   end; {...if DemoResource.Stream^.Status <> stOk }
  998.  
  999.   DemoStrings := PStringList(DemoResource.Get('Strings'));
  1000.  
  1001.   { Assign values to the GLResFile and GLStringList pointers in the
  1002.     GLSupprt unit, so that the spreadsheet object knows where to
  1003.     find the resources it needs }
  1004.  
  1005.   GLResFile := @DemoResource;
  1006.   GLStringList := PStringList(DemoResource.Get('SheetStrings'));
  1007.  
  1008.   if DemoResource.Stream^.Status <> stOk then
  1009.   begin
  1010.     writeln('Problems accesing resource file...program aborted');
  1011.     halt(1);
  1012.   end; {...if DemoResource.Stream^.Status <> stOk }
  1013.   Demo.Init('');
  1014.   Demo.Run;
  1015.   Demo.Done;
  1016.  
  1017.   Dispose(GLStringList, Done);
  1018.   Dispose(DemoStrings, Done);
  1019.   DemoResource.Done;
  1020.  
  1021.   if MemAvail <> SaveMem then
  1022.   begin
  1023.     writeln('Memory not de-allocated: ', MemAvail-SaveMem);
  1024.     writeln;
  1025.   end; {...if MemAvail <> SaveMem }
  1026. end. {...Program OOGL_DemoProgram }
  1027.